home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / infor / tsptp.zip / GAMM.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-09  |  5KB  |  180 lines
  1. (******************************************************************************)
  2. (*                                GAMM.PAS                                    *)
  3. (*                                                                            *)
  4. (*  Gamm Benchmark.  Based upon Pascal Validation Suite test 1.2-2.           *)
  5. (*  Copyright A H J Sale and British Standards Institution, 1985.             *)
  6. (******************************************************************************)
  7.  
  8. PROGRAM GAMM(Output);
  9.  
  10. (******************************************************************************)
  11. (*                                TIMING                                      *)
  12. (******************************************************************************)
  13.  
  14. (*$IFNDEF TopSpeed *)
  15.  (*%F TRUE   *** Compile for Turbo Pascal ***)
  16.   USES TPBench;
  17.  (*%E*)
  18. (*$ELSE     *** Compile for TopSpeed Pascal ***)
  19.   IMPORT TSBench *;
  20. (*$ENDIF *)
  21.  
  22. (******************************************************************************)
  23.  
  24.   CONST
  25.     ITERATIONS = 10;
  26.     five       = 5;
  27.     ten        = 10;
  28.     thirty     = 30;
  29.  
  30.   VAR
  31.     i       : 1..30;
  32.     acc, acc1,
  33.     divn, rn,
  34.     root,
  35.     x, y    : BmReal;
  36.     a, b, c : ARRAY [1 .. thirty] OF BmReal;
  37.  
  38.   PROCEDURE GammProc;
  39.     VAR i : 1..30;
  40.   BEGIN
  41.   (*** One pass of this procedure corresponds TO 300 Gamm units. ***)
  42.     (*** First addition/subtraction loop. ***)
  43.     FOR i := thirty DOWNTO 1 DO
  44.        c[i] := a[i] + b[i];
  45.  
  46.     (*** First polynomial loop. ***)
  47.     y := 0.0;
  48.     FOR i := 1 TO ten DO
  49.        y := (y + c[i]) * x;
  50.  
  51.     acc1 := y * divn;
  52.  
  53.     (*** First maximum element loop. ***)
  54.     y := c[11];
  55.     FOR i := 12 TO 20  DO
  56.       IF c[i] > y THEN
  57.         y := c[i];
  58.  
  59.     (*** First square root loop. ***)
  60.     root := 1.0;
  61.     FOR i := 1 TO 5 DO
  62.       root := 0.5 * (root + y/root);
  63.  
  64.     acc1 := acc1 + root * divn;
  65.  
  66.     (*** Second addition/subtraction loop. ***)
  67.     FOR i := 1 TO thirty DO
  68.       a[i] := c[i] - b[i];
  69.  
  70.     (*** Second polynomial loop. ***)
  71.     y := 0.0;
  72.     FOR i := 1 TO ten DO
  73.        y := (y + a[i]) * x;
  74.  
  75.     (*** Second square root loop. ***)
  76.     root := 1.0;
  77.     FOR i := 1 TO five DO
  78.        root := 0.5 * (root + y/root);
  79.  
  80.     acc1 := acc1 + root * divn;
  81.  
  82.     (*** First multiplication loop. ***)
  83.     FOR i := 1 TO thirty DO
  84.        c[i] := c[i] * b[i];
  85.  
  86.     (*** Second maximum element loop. ***)
  87.     y := c[20];
  88.     FOR i := 21 TO thirty  DO
  89.        IF c[i] > y THEN
  90.            y := c[i];
  91.  
  92.     (*** Third square root loop. ***)
  93.     root := 1.0;
  94.     FOR i := 1 TO 5 DO
  95.        root := 0.5 * (root + y/root);
  96.  
  97.     acc1 := acc1 + root * divn;
  98.  
  99.     (*** Third polynomial loop. ***)
  100.     y := 0.0;
  101.     FOR i := 1 TO ten DO
  102.        y := (y + c[i]) * x;
  103.  
  104.     acc1 := acc1 + y * divn;
  105.  
  106.     (*** Third maximum element loop. ***)
  107.     y := c[1];
  108.     FOR i := 2 TO ten DO
  109.       IF c[i] > y THEN
  110.           y := c[i];
  111.  
  112.     (*** Fourth square root loop. ***)
  113.     root := 1.0;
  114.     FOR i := 1 TO five DO
  115.        root := 0.5 * (root + y/root);
  116.  
  117.     acc1 := acc1 + root * divn;
  118.     acc := acc + acc1
  119.  
  120.   END;
  121.  
  122. BEGIN
  123.  
  124.   WriteLn('Gamm Benchmark');
  125.  
  126. (******************************************************************************)
  127. (*  Compute the looping overhead.  The Dummy procedure must have some side-   *)
  128. (*  effect so that it is not optimised out of existence.                      *)
  129. (******************************************************************************)
  130.  
  131.   StartTimer;                                   (* Start the clock.           *)
  132.  
  133.   REPEAT
  134.     Dummy;
  135.   UNTIL NullTimesUp;
  136.  
  137. (******************************************************************************)
  138. (*  Now run the benchmark.  Note that the Dummy procedure is also called so   *)
  139. (*  that we can eliminate its overhead from the looping overhead.             *)
  140. (******************************************************************************)
  141.  
  142.   StartTimer;                                   (* Start the clock.           *)
  143.  
  144.   REPEAT
  145.     rn   := ITERATIONS;
  146.     divn := 1.0 / rn;
  147.     x    := 0.1;
  148.     y    := 1.0;
  149.     acc  := 0.0;
  150.  
  151.     FOR i := 1 TO 30 DO                         (* Initialise a and b.        *)
  152.     BEGIN
  153.       a[i] := i;
  154.       b[i] := - y;
  155.       y    := - y
  156.     END;
  157.  
  158.     FOR i := 1 TO ITERATIONS DO
  159.       GammProc;
  160.  
  161.     Dummy
  162.   UNTIL BenchTimesUp;
  163.  
  164. (******************************************************************************)
  165.  
  166.   ReportTimes;
  167.  
  168.   (*** Print the results.  Should print n then:                             ***)
  169.   (***  16.73343 22410 90064 71684 80142 13037 73134 63992 40462 96035      ***)
  170.   (***     41872 24481 65285 24815 99961 62435 26126 76234 69822 97966      ***)
  171.   (***  and then 16.73 ... / ITERATIONS                                     ***)
  172.   (***  Format should be adjusted to print to maximum precision.            ***)
  173.  
  174.   WriteLn;
  175.   WriteLn('Program      acc = ', acc:31);
  176.   WriteLn('Theoretical  acc =  1.67334322410900647168480E+1');
  177.   WriteLn('Program     acc1 = ', acc1:31);
  178.   WriteLn('Theoretical acc1 = ', 16.7334322410900647168480/rn:31);
  179. END.
  180.